home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / Rxmenus.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  58.4 KB  |  1,861 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RxMenus;
  13.  
  14. {$I RX.INC}
  15. {$S-,W-,R-}
  16.  
  17. interface
  18.  
  19. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF} SysUtils,
  20.   Classes, Controls, Messages, Graphics, {$IFDEF RX_D4} ImgList, {$ENDIF}
  21.   Menus, RxHook;
  22.  
  23. type
  24.   TRxMenuStyle = (msStandard, msOwnerDraw {$IFDEF WIN32}, msBtnLowered,
  25.     msBtnRaised {$ENDIF});
  26.   TMenuOwnerDrawState = set of (mdSelected, mdGrayed, mdDisabled, mdChecked,
  27.     mdFocused {$IFDEF WIN32}, mdDefault {$ENDIF});
  28.  
  29.   TDrawMenuItemEvent = procedure(Sender: TMenu; Item: TMenuItem; Rect: TRect;
  30.     State: TMenuOwnerDrawState) of object;
  31.   TMeasureMenuItemEvent = procedure(Sender: TMenu; Item: TMenuItem; var Width,
  32.     Height: Integer) of object;
  33.   TDrawMarginEvent = procedure(Sender: TMenu; Rect: TRect) of object;
  34.   TItemParamsEvent = procedure(Sender: TMenu; Item: TMenuItem;
  35.     State: TMenuOwnerDrawState; AFont: TFont; var Color: TColor;
  36.     var Graphic: TGraphic; var NumGlyphs: Integer) of object;
  37. {$IFDEF WIN32}
  38.   TItemImageEvent = procedure(Sender: TMenu; Item: TMenuItem;
  39.     State: TMenuOwnerDrawState; var ImageIndex: Integer) of object;
  40. {$ENDIF}
  41.  
  42. { TRxMainMenu }
  43.  
  44.   TRxMainMenu = class(TMainMenu)
  45.   private
  46.     FStyle: TRxMenuStyle;
  47.     FCanvas: TCanvas;
  48.     FHook: TRxWindowHook;
  49.     FShowCheckMarks: Boolean;
  50.     FMinTextOffset: Cardinal;
  51.     FCursor: TCursor;
  52.     FOnDrawItem: TDrawMenuItemEvent;
  53.     FOnMeasureItem: TMeasureMenuItemEvent;
  54.     FOnGetItemParams: TItemParamsEvent;
  55. {$IFDEF WIN32}
  56.     FImages: TImageList;
  57.     FImageChangeLink: TChangeLink;
  58.     FOnGetImageIndex: TItemImageEvent;
  59.     procedure SetImages(Value: TImageList);
  60.     procedure ImageListChange(Sender: TObject);
  61. {$ENDIF}
  62.     procedure SetStyle(Value: TRxMenuStyle);
  63.     function FindForm: TWinControl;
  64.     procedure WndMessage(Sender: TObject; var AMsg: TMessage;
  65.       var Handled: Boolean);
  66.     procedure CMMenuChanged(var Message: TMessage); message CM_MENUCHANGED;
  67.     procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
  68.     procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
  69.     procedure WMMenuSelect(var Message: TWMMenuSelect); message WM_MENUSELECT;
  70.   protected
  71.     procedure Loaded; override;
  72. {$IFDEF WIN32}
  73.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  74.     procedure GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  75.       var ImageIndex: Integer); dynamic;
  76. {$ENDIF}
  77.     procedure DrawItem(Item: TMenuItem; Rect: TRect;
  78.       State: TMenuOwnerDrawState); virtual;
  79.     procedure GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  80.       AFont: TFont; var Color: TColor; var Graphic: TGraphic;
  81.       var NumGlyphs: Integer); dynamic;
  82.     procedure MeasureItem(Item: TMenuItem; var Width, Height: Integer); dynamic;
  83.     procedure RefreshMenu(AOwnerDraw: Boolean); virtual;
  84.     function IsOwnerDrawMenu: Boolean;
  85.   public
  86.     constructor Create(AOwner: TComponent); override;
  87.     destructor Destroy; override;
  88.     procedure Refresh;
  89.     procedure DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  90.       State: TMenuOwnerDrawState);
  91.     property Canvas: TCanvas read FCanvas;
  92.   published
  93.     property Cursor: TCursor read FCursor write FCursor default crDefault;
  94.     property MinTextOffset: Cardinal read FMinTextOffset write FMinTextOffset default 0;
  95.     property Style: TRxMenuStyle read FStyle write SetStyle default msStandard;
  96.     property ShowCheckMarks: Boolean read FShowCheckMarks write FShowCheckMarks default True;
  97. {$IFDEF RX_D4}
  98.     property OwnerDraw stored False;
  99. {$ENDIF}
  100. {$IFDEF WIN32}
  101.     property Images: TImageList read FImages write SetImages;
  102.     property OnGetImageIndex: TItemImageEvent read FOnGetImageIndex write FOnGetImageIndex;
  103. {$ENDIF}
  104.     property OnDrawItem: TDrawMenuItemEvent read FOnDrawItem write FOnDrawItem;
  105.     property OnGetItemParams: TItemParamsEvent read FOnGetItemParams write FOnGetItemParams;
  106.     property OnMeasureItem: TMeasureMenuItemEvent read FOnMeasureItem write FOnMeasureItem;
  107.   end;
  108.  
  109. { TRxPopupMenu }
  110.  
  111.   TRxPopupMenu = class(TPopupMenu)
  112.   private
  113.     FStyle: TRxMenuStyle;
  114.     FCanvas: TCanvas;
  115.     FShowCheckMarks: Boolean;
  116.     FMinTextOffset: Cardinal;
  117.     FLeftMargin: Cardinal;
  118.     FCursor: TCursor;
  119.     FOnDrawItem: TDrawMenuItemEvent;
  120.     FOnMeasureItem: TMeasureMenuItemEvent;
  121.     FOnDrawMargin: TDrawMarginEvent;
  122.     FOnGetItemParams: TItemParamsEvent;
  123. {$IFDEF RX_D4}
  124.     FPopupPoint: TPoint;
  125.     FParentBiDiMode: Boolean;
  126. {$ENDIF}
  127. {$IFDEF WIN32}
  128.     FImages: TImageList;
  129.     FImageChangeLink: TChangeLink;
  130.     FOnGetImageIndex: TItemImageEvent;
  131.     procedure SetImages(Value: TImageList);
  132.     procedure ImageListChange(Sender: TObject);
  133. {$ENDIF}
  134.     procedure SetStyle(Value: TRxMenuStyle);
  135.     procedure WndMessage(Sender: TObject; var AMsg: TMessage;
  136.       var Handled: Boolean);
  137.     procedure WMDrawItem(var Message: TWMDrawItem); message WM_DRAWITEM;
  138.     procedure WMMeasureItem(var Message: TWMMeasureItem); message WM_MEASUREITEM;
  139. {$IFDEF RX_D4}
  140.     procedure SetBiDiModeFromPopupControl;
  141. {$ENDIF}
  142.   protected
  143.     procedure Loaded; override;
  144. {$IFDEF RX_D4}
  145.     function UseRightToLeftAlignment: Boolean;
  146. {$ENDIF}
  147. {$IFDEF WIN32}
  148.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  149.     procedure GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  150.       var ImageIndex: Integer); dynamic;
  151. {$ENDIF}
  152.     procedure DrawItem(Item: TMenuItem; Rect: TRect;
  153.       State: TMenuOwnerDrawState); virtual;
  154.     procedure DrawMargin(ARect: TRect); virtual;
  155.     procedure GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  156.       AFont: TFont; var Color: TColor; var Graphic: TGraphic;
  157.       var NumGlyphs: Integer); dynamic;
  158.     procedure MeasureItem(Item: TMenuItem; var Width, Height: Integer); dynamic;
  159.     procedure RefreshMenu(AOwnerDraw: Boolean); virtual;
  160.     function IsOwnerDrawMenu: Boolean;
  161.   public
  162.     constructor Create(AOwner: TComponent); override;
  163.     destructor Destroy; override;
  164.     procedure Refresh;
  165.     procedure Popup(X, Y: Integer); override;
  166.     procedure DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  167.       State: TMenuOwnerDrawState);
  168.     procedure DefaultDrawMargin(ARect: TRect; StartColor, EndColor: TColor);
  169.     property Canvas: TCanvas read FCanvas;
  170.   published
  171.     property Cursor: TCursor read FCursor write FCursor default crDefault;
  172.     property LeftMargin: Cardinal read FLeftMargin write FLeftMargin default 0;
  173.     property MinTextOffset: Cardinal read FMinTextOffset write FMinTextOffset default 0;
  174.     property Style: TRxMenuStyle read FStyle write SetStyle default msStandard;
  175.     property ShowCheckMarks: Boolean read FShowCheckMarks write FShowCheckMarks default True;
  176. {$IFDEF RX_D4}
  177.     property OwnerDraw stored False;
  178. {$ENDIF}
  179. {$IFDEF WIN32}
  180.     property Images: TImageList read FImages write SetImages;
  181.     property OnGetImageIndex: TItemImageEvent read FOnGetImageIndex write FOnGetImageIndex;
  182. {$ENDIF}
  183.     property OnDrawItem: TDrawMenuItemEvent read FOnDrawItem write FOnDrawItem;
  184.     property OnDrawMargin: TDrawMarginEvent read FOnDrawMargin write FOnDrawMargin;
  185.     property OnGetItemParams: TItemParamsEvent read FOnGetItemParams write FOnGetItemParams;
  186.     property OnMeasureItem: TMeasureMenuItemEvent read FOnMeasureItem write FOnMeasureItem;
  187.   end;
  188.  
  189. { Utility routines }
  190.  
  191. procedure SetDefaultMenuFont(AFont: TFont);
  192. function IsItemPopup(Item: TMenuItem): Boolean;
  193.  
  194. implementation
  195.  
  196. uses {$IFDEF WIN32} CommCtrl, {$ENDIF} Forms, ExtCtrls, Consts, RxConst,
  197.   MaxMin, VclUtils, ClipIcon, rxStrUtils;
  198.  
  199. const
  200.   DefMarginColor: TColor = clBlue;
  201.   AddWidth = 2;
  202.   AddHeight = 4;
  203.   Tab = #9#9;
  204.   Separator = '-';
  205.  
  206. type
  207.   TBtnStyle = (bsNone, bsLowered, bsRaised, bsOffice);
  208.  
  209. function BtnStyle(MenuStyle: TRxMenuStyle): TBtnStyle;
  210. begin
  211. {$IFDEF WIN32}
  212.   case MenuStyle of
  213.     msBtnLowered: Result := bsLowered;
  214.     msBtnRaised: Result := bsRaised;
  215.     else Result := bsNone;
  216.   end;
  217. {$ELSE}
  218.   Result := bsNone;
  219. {$ENDIF}
  220. end;
  221.  
  222. function IsItemPopup(Item: TMenuItem): Boolean;
  223. begin
  224.   Result := (Item.Parent = nil) or (Item.Parent.Parent <> nil) or
  225.     not (Item.Parent.Owner is TMainMenu);
  226. end;
  227.  
  228. {$IFNDEF WIN32}
  229. const
  230.   { return codes for WM_MENUCHAR (not defined in Delphi 1.0) }
  231.   MNC_IGNORE = 0;
  232.   MNC_CLOSE = 1;
  233.   MNC_EXECUTE = 2;
  234.   MNC_SELECT = 3;
  235. {$ENDIF}
  236.  
  237. {$IFNDEF RX_D4}
  238. procedure ProcessMenuChar(AMenu: TMenu; var Message: TWMMenuChar);
  239. var
  240.   C, I, First, Hilite, Next: Integer;
  241.   State: Word;
  242.  
  243.   function IsAccelChar(Menu: HMENU; State: Word; I: Integer; C: Char): Boolean;
  244.   var
  245.     Item: TMenuItem;
  246.     Id: Cardinal;
  247.   begin
  248.     Item := nil;
  249.     if State and MF_POPUP <> 0 then begin
  250.       Menu := GetSubMenu(Menu, I);
  251.       Item := AMenu.FindItem(Menu, fkHandle);
  252.     end
  253.     else begin
  254.       Id := GetMenuItemID(Menu, I);
  255.       if Id <> {$IFDEF WIN32} $FFFFFFFF {$ELSE} $FFFF {$ENDIF} then
  256.         Item := AMenu.FindItem(Id, fkCommand);
  257.     end;
  258.     if Item <> nil then Result := IsAccel(Ord(C), Item.Caption)
  259.     else Result := False;
  260.   end;
  261.  
  262.   function IsInitialChar(Menu: HMENU; State: Word; I: Integer; C: Char): Boolean;
  263.   var
  264.     Item: TMenuItem;
  265.   begin
  266.     if State and MF_POPUP <> 0 then begin
  267.       Menu := GetSubMenu(Menu, I);
  268.       Item := AMenu.FindItem(Menu, fkHandle);
  269.     end
  270.     else begin
  271.       Item := AMenu.FindItem(Menu, fkHandle);
  272.       if Item <> nil then Item := Item.Items[I];
  273.     end;
  274.     if (Item <> nil) and (Item.Caption <> '') then
  275.       Result := AnsiCompareText(Item.Caption[1], C) = 0
  276.     else Result := False;
  277.   end;
  278.  
  279. begin
  280.   with Message do begin
  281.     Result := MNC_IGNORE; { No item found: beep }
  282.     First := -1;
  283.     Hilite := -1;
  284.     Next := -1;
  285.     C := GetMenuItemCount(Menu);
  286.     for I := 0 to C - 1 do begin
  287.       State := GetMenuState(Menu, I, MF_BYPOSITION);
  288.       if IsAccelChar(Menu, State, I, User) then begin
  289.         if State and MF_DISABLED <> 0 then begin
  290.           { Close the menu if this is the only disabled item to choose from.
  291.             Otherwise, ignore the item. }
  292.           if First < 0 then First := -2;
  293.           Continue;
  294.         end;
  295.         if First < 0 then begin
  296.           First := I;
  297.           Result := MNC_EXECUTE;
  298.         end
  299.         else Result := MNC_SELECT;
  300.         if State and MF_HILITE <> 0 then Hilite := I
  301.         else if Hilite >= 0 then Next := I;
  302.       end;
  303.     end;
  304.     { We found a single disabled item. End the selection. }
  305.     if First < -1 then begin
  306.       Result := MNC_CLOSE shl 16;
  307.       Exit;
  308.     end;
  309.  
  310.     { If we can't find accelerators, then look for initial letters }
  311.     if First < 0 then
  312.       for I := 0 to C - 1 do begin
  313.         State := GetMenuState(Menu, I, MF_BYPOSITION);
  314.         if IsInitialChar(Menu, State, I, User) then begin
  315.           if State and MF_DISABLED <> 0 then begin
  316.             Result := MNC_CLOSE shl 16;
  317.             Exit;
  318.           end;
  319.           if First < 0 then begin
  320.             First := I;
  321.             Result := MNC_EXECUTE;
  322.           end
  323.           else Result := MNC_SELECT;
  324.           if State and MF_HILITE <> 0 then Hilite := I
  325.           else if Hilite >= 0 then Next := I;
  326.         end;
  327.       end;
  328.  
  329.     if (Result = MNC_EXECUTE) then Result := Result shl 16 or First
  330.     else if Result = MNC_SELECT then begin
  331.       if Next < 0 then Next := First;
  332.       Result := Result shl 16 or Next;
  333.     end;
  334.   end;
  335. end;
  336. {$ENDIF RX_D4}
  337.  
  338. procedure MenuWndMessage(Menu: TMenu; var AMsg: TMessage; var Handled: Boolean);
  339. var
  340.   Message: TMessage;
  341.   Item: Pointer;
  342. begin
  343.   with AMsg do
  344.     case Msg of
  345.       WM_MEASUREITEM:
  346.         if (TWMMeasureItem(AMsg).MeasureItemStruct^.CtlType = ODT_MENU) then
  347.         begin
  348.           Item := Menu.FindItem(TWMMeasureItem(AMsg).MeasureItemStruct^.itemID, fkCommand);
  349.           if Item <> nil then begin
  350.             Message := AMsg;
  351.             TWMMeasureItem(Message).MeasureItemStruct^.ItemData := Longint(Item);
  352.             Menu.Dispatch(Message);
  353.             Result := 1;
  354.             Handled := True;
  355.           end;
  356.         end;
  357.       WM_DRAWITEM:
  358.         if (TWMDrawItem(AMsg).DrawItemStruct^.CtlType = ODT_MENU) then
  359.         begin
  360.           Item := Menu.FindItem(TWMDrawItem(AMsg).DrawItemStruct^.itemID, fkCommand);
  361.           if Item <> nil then begin
  362.             Message := AMsg;
  363.             TWMDrawItem(Message).DrawItemStruct^.ItemData := Longint(Item);
  364.             Menu.Dispatch(Message);
  365.             Result := 1;
  366.             Handled := True;
  367.           end;
  368.         end;
  369.       WM_MENUSELECT: Menu.Dispatch(AMsg);
  370.       CM_MENUCHANGED: Menu.Dispatch(AMsg);
  371.       WM_MENUCHAR:
  372.         begin
  373. {$IFDEF RX_D4}
  374.           Menu.ProcessMenuChar(TWMMenuChar(AMsg));
  375. {$ELSE}
  376.           ProcessMenuChar(Menu, TWMMenuChar(AMsg));
  377. {$ENDIF}
  378.         end;
  379.     end;
  380. end;
  381.  
  382. {$IFNDEF RX_D4}
  383. procedure RefreshMenuItem(MenuItem: TMenuItem; OwnerDraw: Boolean);
  384. const
  385.   Breaks: array[TMenuBreak] of Longint = (0, MF_MENUBREAK, MF_MENUBARBREAK);
  386.   Checks: array[Boolean] of LongInt = (MF_UNCHECKED, MF_CHECKED);
  387.   Enables: array[Boolean] of LongInt = (MF_DISABLED or MF_GRAYED, MF_ENABLED);
  388.   Separators: array[Boolean] of LongInt = (MF_STRING, MF_SEPARATOR);
  389. {$IFDEF WIN32}
  390.   IBreaks: array[TMenuBreak] of DWORD = (MFT_STRING, MFT_MENUBREAK, MFT_MENUBARBREAK);
  391.   IRadios: array[Boolean] of DWORD = (MFT_STRING, MFT_RADIOCHECK);
  392.   ISeparators: array[Boolean] of DWORD = (MFT_STRING, MFT_SEPARATOR);
  393.   IOwnerDraw: array[Boolean] of DWORD = (MFT_STRING, MFT_OWNERDRAW);
  394. {$ENDIF}
  395. var
  396. {$IFDEF WIN32}
  397.   MenuItemInfo: TMenuItemInfo;
  398. {$ENDIF}
  399.   CCaption: array[0..255] of Char;
  400.   NewFlags: Integer;
  401.   ItemID, I, C: Integer;
  402.   MenuHandle: THandle;
  403.   Item: TMenuItem;
  404.  
  405. {$IFDEF WIN32}
  406.   procedure PrepareItemInfo;
  407.   begin
  408.     FillChar(MenuItemInfo, SizeOf(TMenuItemInfo), 0);
  409.     with MenuItemInfo do begin
  410.       cbSize := SizeOf(TMenuItemInfo);
  411.       fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or MIIM_STATE or
  412.         MIIM_SUBMENU or MIIM_TYPE;
  413.       cch := SizeOf(CCaption) - 1;
  414.     end;
  415.   end;
  416. {$ENDIF}
  417.  
  418. begin
  419.   if (MenuItem <> nil) then begin
  420.     StrPCopy(CCaption, MenuItem.Caption);
  421.     NewFlags := Breaks[MenuItem.Break] or Checks[MenuItem.Checked] or
  422.       Enables[MenuItem.Enabled] or Separators[MenuItem.Caption = Separator] or
  423.       MF_BYCOMMAND;
  424.     ItemID := MenuItem.Command;
  425.     if MenuItem.Count > 0 then begin
  426.       NewFlags := NewFlags or MF_POPUP;
  427.       ItemID := MenuItem.Handle;
  428.     end
  429.     else begin
  430.       if (MenuItem.ShortCut <> scNone) and ((MenuItem.Parent = nil) or
  431.         (MenuItem.Parent.Parent <> nil) or
  432.         not (MenuItem.Parent.Owner is TMainMenu)) then
  433.           StrPCopy(StrECopy(StrEnd(CCaption), Tab),
  434.             ShortCutToText(MenuItem.ShortCut));
  435.     end;
  436.     Item := MenuItem;
  437.     while Item.Parent <> nil do Item := Item.Parent;
  438.     if (Item.Owner <> nil) and (Item.Owner is TMenu) then
  439.       MenuHandle := TMenu(Item.Owner).Handle
  440.     else
  441.       MenuHandle := Item.Handle;
  442. {$IFDEF WIN32}
  443.     if Lo(GetVersion) >= 4 then begin
  444.       FillChar(MenuItemInfo, SizeOf(TMenuItemInfo), 0);
  445.       MenuItemInfo.cbSize := SizeOf(TMenuItemInfo);
  446.       if MenuItem.Count > 0 then begin
  447.         MenuItemInfo.fMask := MIIM_DATA or MIIM_TYPE;
  448.         with MenuItem do
  449.           MenuItemInfo.fType := IRadios[RadioItem] or IBreaks[Break] or
  450.             ISeparators[Caption = Separator] or IOwnerDraw[OwnerDraw];
  451.         MenuItemInfo.dwTypeData := CCaption;
  452.         SetMenuItemInfo(MenuHandle, MenuItem.Command, False, MenuItemInfo);
  453.       end
  454.       else begin
  455.         C := GetMenuItemCount(MenuHandle);
  456.         ItemID := -1;
  457.         for I := 0 to C - 1 do begin
  458.           PrepareItemInfo;
  459.           MenuItemInfo.dwTypeData := CCaption;
  460.           GetMenuItemInfo(MenuHandle, I, True, MenuItemInfo);
  461.           if MenuItemInfo.wID = MenuItem.Command then begin
  462.             ItemID := I;
  463.             Break;
  464.           end;
  465.         end;
  466.         if (ItemID < 0) and (MenuItem.Parent <> nil) then begin
  467.           MenuHandle := MenuItem.Parent.Handle;
  468.           C := GetMenuItemCount(MenuHandle);
  469.           for I := 0 to C - 1 do begin
  470.             PrepareItemInfo;
  471.             MenuItemInfo.dwTypeData := CCaption;
  472.             GetMenuItemInfo(MenuHandle, I, True, MenuItemInfo);
  473.             if MenuItemInfo.wID = MenuItem.Command then begin
  474.               ItemID := I;
  475.               Break;
  476.             end;
  477.           end;
  478.         end;
  479.         if ItemID < 0 then Exit;
  480.         with MenuItem do
  481.           MenuItemInfo.fType := IRadios[RadioItem] or IBreaks[Break] or
  482.             ISeparators[Caption = Separator] or IOwnerDraw[OwnerDraw];
  483.         MenuItemInfo.dwTypeData := CCaption;
  484.         DeleteMenu(MenuHandle, MenuItem.Command, MF_BYCOMMAND);
  485.         InsertMenuItem(MenuHandle, ItemID, True, MenuItemInfo);
  486.       end;
  487.     end
  488.     else
  489. {$ENDIF WIN32}
  490.     begin
  491.       if OwnerDraw then begin
  492.         ModifyMenu(MenuHandle, MenuItem.Command, NewFlags or MF_OWNERDRAW and
  493.           not MF_STRING, ItemID, PChar(MenuItem));
  494.       end
  495.       else begin
  496.         ModifyMenu(MenuHandle, MenuItem.Command, NewFlags, ItemID, CCaption);
  497.       end;
  498.     end;
  499.     for I := 0 to MenuItem.Count - 1 do
  500.       RefreshMenuItem(MenuItem.Items[I], OwnerDraw);
  501.   end;
  502. end;
  503. {$ENDIF RX_D4}
  504.  
  505. procedure SetDefaultMenuFont(AFont: TFont);
  506. {$IFDEF WIN32}
  507. var
  508.   NCMetrics: TNonCLientMetrics;
  509. {$ENDIF}
  510. begin
  511. {$IFDEF WIN32}
  512.   if NewStyleControls then begin
  513.     NCMetrics.cbSize := SizeOf(TNonCLientMetrics);
  514.     if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NCMetrics, 0) then
  515.     begin
  516.       AFont.Handle := CreateFontIndirect(NCMetrics.lfMenuFont);
  517.       Exit;
  518.     end;
  519.   end;
  520. {$ENDIF}
  521.   with AFont do begin
  522.     if NewStyleControls then Name := 'MS Sans Serif'
  523.     else Name := 'System';
  524.     Size := 8;
  525.     Color := clMenuText;
  526.     Style := [];
  527.   end;
  528.   AFont.Color := clMenuText;
  529. end;
  530.  
  531. function GetDefItemHeight: Integer;
  532. begin
  533.   Result := GetSystemMetrics(SM_CYMENU);
  534.   if NewStyleControls then Dec(Result, 2);
  535. end;
  536.  
  537. function GetMarginOffset: Integer;
  538. begin
  539.   Result := Round(LoWord(GetMenuCheckMarkDimensions) * 0.3);
  540. end;
  541.  
  542. procedure MenuLine(Canvas: TCanvas; C: TColor; X1, Y1, X2, Y2: Integer);
  543. begin
  544.   with Canvas do begin
  545.     Pen.Color := C;
  546.     MoveTo(X1, Y1);
  547.     LineTo(X2, Y2);
  548.   end;
  549. end;
  550.  
  551. procedure DrawDisabledBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap;
  552.   State: TMenuOwnerDrawState);
  553. const
  554.   ROP_DSPDxax = $00E20746;
  555. var
  556.   Bmp: TBitmap;
  557.   GrayColor, SaveColor: TColor;
  558.   IsHighlight: Boolean;
  559. begin
  560.   if (mdSelected in State) then GrayColor := clGrayText
  561.   else GrayColor := clBtnShadow;
  562.   IsHighlight := NewStyleControls and ((not (mdSelected in State)) or
  563.     (GetNearestColor(Canvas.Handle, ColorToRGB(clGrayText)) =
  564.     GetNearestColor(Canvas.Handle, ColorToRGB(clHighlight))));
  565.   if Bitmap.Monochrome then begin
  566.     SaveColor := Canvas.Brush.Color;
  567.     try
  568.       if IsHighlight then begin
  569.         Canvas.Brush.Color := clBtnHighlight;
  570.         SetTextColor(Canvas.Handle, clWhite);
  571.         SetBkColor(Canvas.Handle, clBlack);
  572.         BitBlt(Canvas.Handle, X + 1, Y + 1, Bitmap.Width, Bitmap.Height,
  573.           Bitmap.Canvas.Handle, 0, 0, ROP_DSPDxax);
  574.       end;
  575.       Canvas.Brush.Color := GrayColor;
  576.       SetTextColor(Canvas.Handle, clWhite);
  577.       SetBkColor(Canvas.Handle, clBlack);
  578.       BitBlt(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height,
  579.         Bitmap.Canvas.Handle, 0, 0, ROP_DSPDxax);
  580.     finally
  581.       Canvas.Brush.Color := SaveColor;
  582.     end;
  583.   end
  584.   else begin
  585.     Bmp := CreateDisabledBitmapEx(Bitmap, clBlack, clMenu,
  586.       clBtnHighlight, GrayColor, IsHighlight);
  587.     try
  588.       DrawBitmapTransparent(Canvas, X, Y, Bmp, clMenu);
  589.     finally
  590.       Bmp.Free;
  591.     end;
  592.   end;
  593. end;
  594.  
  595. procedure DrawMenuBitmap(Canvas: TCanvas; X, Y: Integer; Bitmap: TBitmap;
  596.   IsColor: Boolean; State: TMenuOwnerDrawState);
  597. begin
  598.   if (mdDisabled in State) then
  599.     DrawDisabledBitmap(Canvas, X, Y, Bitmap, State)
  600.   else begin
  601.     if Bitmap.Monochrome and not IsColor then
  602.       BitBlt(Canvas.Handle, X, Y, Bitmap.Width, Bitmap.Height,
  603.         Bitmap.Canvas.Handle, 0, 0, SRCCOPY)
  604.     else
  605.       DrawBitmapTransparent(Canvas, X, Y, Bitmap, Bitmap.TransparentColor
  606.         and not PaletteMask);
  607.   end;
  608. end;
  609.  
  610. procedure DrawMenuItem(AMenu: TMenu; Item: TMenuItem; Glyph: TGraphic;
  611.   NumGlyphs: Integer; Canvas: TCanvas; ShowCheck: Boolean; Buttons: TBtnStyle;
  612.   Rect: TRect; MinOffset: {$IFDEF RX_D4} Integer {$ELSE} Cardinal {$ENDIF};
  613.   State: TMenuOwnerDrawState {$IFDEF WIN32}; Images: TImageList;
  614.   ImageIndex: Integer {$ENDIF});
  615. var
  616.   Left, LineTop, MaxWidth, I, W: Integer;
  617.   CheckSize: Longint;
  618.   BtnRect: TRect;
  619.   IsPopup, DrawHighlight, DrawLowered: Boolean;
  620.   GrayColor: TColor;
  621.   Bmp: TBitmap;
  622. {$IFDEF WIN32}
  623.   Ico: HIcon;
  624.   H: Integer;
  625. {$ENDIF}
  626. {$IFDEF RX_D4}
  627.   ParentMenu: TMenu;
  628. {$ENDIF}
  629.  
  630.   procedure MenuTextOut(X, Y: Integer; const Text: string; Flags: Longint);
  631.   var
  632.     R: TRect;
  633.   begin
  634.     if Length(Text) = 0 then Exit;
  635. {$IFDEF RX_D4}
  636.     if (ParentMenu <> nil) and (ParentMenu.IsRightToLeft) then begin
  637.       if Flags and DT_LEFT = DT_LEFT then
  638.         Flags := Flags and (not DT_LEFT) or DT_RIGHT
  639.       else if Flags and DT_RIGHT = DT_RIGHT then
  640.         Flags := Flags and (not DT_RIGHT) or DT_LEFT;
  641.       Flags := Flags or DT_RTLREADING;
  642.     end;
  643. {$ENDIF}
  644.     R := Rect; R.Left := X; R.Top := Y;
  645.     if (mdDisabled in State) then begin
  646.       if DrawHighlight then begin
  647.         Canvas.Font.Color := clBtnHighlight;
  648.         OffsetRect(R, 1, 1);
  649.         DrawText(Canvas.Handle, @Text[1], Length(Text), R, Flags);
  650.         OffsetRect(R, -1, -1);
  651.       end;
  652.       Canvas.Font.Color := GrayColor;
  653.     end;
  654.     DrawText(Canvas.Handle, @Text[1], Length(Text), R, Flags)
  655.   end;
  656.  
  657.   procedure DrawCheckImage(X, Y: Integer);
  658.   begin
  659.     Bmp := TBitmap.Create;
  660.     try
  661. {$IFDEF WIN32}
  662.       with Bmp do begin
  663.         Width := LoWord(CheckSize);
  664.         Height := HiWord(CheckSize);
  665.       end;
  666.       if Item.RadioItem then begin
  667.         with Bmp do begin
  668.           DrawFrameControl(Canvas.Handle, Bounds(0, 0, Width, Height),
  669.             DFC_MENU, DFCS_MENUBULLET);
  670.           Monochrome := True;
  671.         end;
  672.       end
  673.       else begin
  674.         with Bmp do begin
  675.           DrawFrameControl(Canvas.Handle, Bounds(0, 0, Width, Height),
  676.             DFC_MENU, DFCS_MENUCHECK);
  677.           Monochrome := True;
  678.         end;
  679.       end;
  680. {$ELSE}
  681.       Bmp.Handle := LoadBitmap(0, PChar(32760));
  682. {$ENDIF}
  683.       DrawMenuBitmap(Canvas, X, Y, Bmp, DrawLowered, State);
  684.     finally
  685.       Bmp.Free;
  686.     end;
  687.   end;
  688.  
  689.   procedure DrawGlyphCheck(ARect: TRect);
  690.   var
  691.     SaveColor: TColor;
  692.     Bmp: TBitmap;
  693.   begin
  694.     InflateRect(ARect, 0, -1);
  695.     SaveColor := Canvas.Brush.Color;
  696.     try
  697.       if not (mdSelected in State) then
  698. {$IFDEF RX_D4}
  699.         Bmp := AllocPatternBitmap(clMenu, clBtnHighlight)
  700. {$ELSE}
  701.         Bmp := CreateTwoColorsBrushPattern(clMenu, clBtnHighlight)
  702. {$ENDIF}
  703.       else Bmp := nil;
  704.       try
  705.         if Bmp <> nil then Canvas.Brush.Bitmap := Bmp
  706.         else Canvas.Brush.Color := clMenu;
  707.         Canvas.FillRect(ARect);
  708.       finally
  709.         Canvas.Brush.Bitmap := nil;
  710. {$IFNDEF RX_D4}
  711.         Bmp.Free;
  712. {$ENDIF}
  713.       end;
  714.     finally
  715.       Canvas.Brush.Color := SaveColor;
  716.     end;
  717.     Frame3D(Canvas, ARect, GrayColor, clBtnHighlight, 1);
  718.   end;
  719.  
  720. {$IFDEF WIN32}
  721.   function UseImages: Boolean;
  722.   begin
  723.     Result := Assigned(Images) and (ImageIndex >= 0) and
  724.       (ImageIndex < Images.Count) and Images.HandleAllocated;
  725.   end;
  726. {$ENDIF}
  727.  
  728. begin
  729.   IsPopup := IsItemPopup(Item);
  730.   
  731.   DrawLowered := Item.Checked and IsPopup and not (ShowCheck or
  732.     (Buttons in [bsLowered, bsRaised]));
  733.   DrawHighlight := NewStyleControls and (not (mdSelected in State) or
  734.     (Buttons in [bsLowered, bsRaised]) or (not IsPopup and
  735.     (Buttons = bsOffice)) or
  736.     (GetNearestColor(Canvas.Handle, ColorToRGB(clGrayText)) =
  737.     GetNearestColor(Canvas.Handle, ColorToRGB(clHighlight))));
  738.   if (mdSelected in State) and not (Buttons in [bsLowered, bsRaised]) then
  739.     GrayColor := clGrayText
  740.   else GrayColor := clBtnShadow;
  741.   if IsPopup then begin
  742.     if ShowCheck then
  743.       CheckSize := GetMenuCheckMarkDimensions
  744.     else
  745.       CheckSize := 2;
  746.     Left := 2 * GetMarginOffset + LoWord(CheckSize);
  747.   end
  748.   else begin
  749.     MinOffset := 0;
  750.     CheckSize := 0;
  751.     Left := GetMarginOffset + 2;
  752.   end;
  753.   if (Buttons <> bsNone) and (mdSelected in State) then begin
  754.     case Buttons of
  755.       bsLowered: Frame3D(Canvas, Rect, clBtnShadow, clBtnHighlight, 1);
  756.       bsRaised: Frame3D(Canvas, Rect, clBtnHighlight, clBtnShadow, 1);
  757.       bsOffice:
  758.         if not IsPopup then
  759.           Frame3D(Canvas, Rect, clBtnShadow, clBtnHighlight, 1);
  760.     end;
  761.   end;
  762.   if Assigned(Item) then begin
  763. {$IFDEF RX_D4}
  764.     ParentMenu := Item.GetParentMenu;
  765. {$ENDIF}
  766.     if Item.Checked and ShowCheck and IsPopup then begin
  767.       DrawCheckImage(Rect.Left + (Left - LoWord(CheckSize)) div 2,
  768.         (Rect.Bottom + Rect.Top - HiWord(CheckSize)) div 2);
  769.     end;
  770. {$IFDEF WIN32}
  771.     if Assigned(Images) and IsPopup then
  772.       MinOffset := Max(MinOffset, Images.Width + AddWidth);
  773. {$ENDIF}
  774.     if not ShowCheck and (Assigned(Glyph) or (MinOffset > 0)) then
  775.       if Buttons = bsOffice then Left := 1
  776.       else Left := GetMarginOffset;
  777. {$IFDEF WIN32}
  778.     if UseImages then begin
  779.       W := Images.Width + AddWidth;
  780.       if W < Integer(MinOffset) then W := MinOffset;
  781.       BtnRect := Bounds(Rect.Left + Left - 1, Rect.Top, W + 2,
  782.         Rect.Bottom - Rect.Top);
  783.       if DrawLowered then DrawGlyphCheck(BtnRect)
  784.       else if (mdSelected in State) and IsPopup and (Buttons = bsOffice) and
  785.         not ShowCheck then
  786.       begin
  787.         Frame3D(Canvas, BtnRect, clBtnHighlight, GrayColor, 1);
  788.       end;
  789.       if (mdDisabled in State) then
  790.         ImageListDrawDisabled(Images, Canvas, Rect.Left + Left +
  791.           (W - Images.Width) div 2, (Rect.Bottom + Rect.Top -
  792.           Images.Height) div 2, ImageIndex, clBtnHighlight, GrayColor,
  793.           DrawHighlight)
  794.       else ImageList_Draw(Images.Handle, ImageIndex, Canvas.Handle,
  795.         Rect.Left + Left + (W - Images.Width) div 2, (Rect.Bottom +
  796.         Rect.Top - Images.Height) div 2, ILD_NORMAL);
  797.       Inc(Left, W + GetMarginOffset);
  798.     end else
  799. {$ENDIF}
  800.     if Assigned(Glyph) and not Glyph.Empty and (Item.Caption <> Separator) then
  801.     begin
  802.       W := Glyph.Width;
  803.       if (Glyph is TBitmap) and (NumGlyphs in [2..5]) then
  804.         W := W div NumGlyphs;
  805.       W := Max(W + AddWidth, MinOffset);
  806. {$IFDEF WIN32}
  807.       if not (Glyph is TIcon) then
  808. {$ENDIF}
  809.       begin
  810.         BtnRect := Bounds(Rect.Left + Left - 1, Rect.Top, W + 2,
  811.           Rect.Bottom - Rect.Top);
  812.         if DrawLowered then DrawGlyphCheck(BtnRect)
  813.         else if (mdSelected in State) and IsPopup and (Buttons = bsOffice) and
  814.           not ShowCheck then
  815.         begin
  816.           Frame3D(Canvas, BtnRect, clBtnHighlight, GrayColor, 1);
  817.         end;
  818.       end;
  819.       if Glyph is TBitmap then begin
  820.         if (NumGlyphs in [2..5]) then begin
  821.           I := 0;
  822.           if (mdDisabled in State) then I := 1
  823.           else if (mdChecked in State) then I := 3
  824.           else if (mdSelected in State) then I := 2;
  825.           if I > NumGlyphs - 1 then I := 0;
  826.           Bmp := TBitmap.Create;
  827.           try
  828.             AssignBitmapCell(Glyph, Bmp, NumGlyphs, 1, I);
  829.             DrawMenuBitmap(Canvas, Rect.Left + Left + (W - Bmp.Width) div 2,
  830.               (Rect.Bottom + Rect.Top - Bmp.Height) div 2, Bmp, DrawLowered,
  831.               State - [mdDisabled]);
  832.           finally
  833.             Bmp.Free;
  834.           end;
  835.         end
  836.         else DrawMenuBitmap(Canvas, Rect.Left + Left + (W - Glyph.Width) div 2,
  837.           (Rect.Bottom + Rect.Top - Glyph.Height) div 2, TBitmap(Glyph),
  838.           DrawLowered, State);
  839.         Inc(Left, W + GetMarginOffset);
  840.       end
  841. {$IFDEF WIN32}
  842.       else if Glyph is TIcon then begin
  843.         Ico := CreateRealSizeIcon(TIcon(Glyph));
  844.         try
  845.           GetIconSize(Ico, W, H);
  846.           I := Max(W + AddWidth, MinOffset);
  847.           BtnRect := Bounds(Rect.Left + Left - 1, Rect.Top, I + 2,
  848.             Rect.Bottom - Rect.Top);
  849.           if DrawLowered then DrawGlyphCheck(BtnRect)
  850.           else if (mdSelected in State) and IsPopup and (Buttons = bsOffice) and
  851.             not ShowCheck then
  852.           begin
  853.             Frame3D(Canvas, BtnRect, clBtnHighlight, GrayColor, 1);
  854.           end;
  855.           DrawIconEx(Canvas.Handle, Rect.Left + Left + (I - W) div 2,
  856.             (Rect.Top + Rect.Bottom - H) div 2, Ico, W, H, 0, 0, DI_NORMAL);
  857.           Inc(Left, I + GetMarginOffset);
  858.         finally
  859.           DestroyIcon(Ico);
  860.         end;
  861.       end
  862. {$ENDIF}
  863.       else begin
  864.         Canvas.Draw(Rect.Left + Left + (W - Glyph.Width) div 2,
  865.           (Rect.Bottom + Rect.Top - Glyph.Height) div 2, Glyph);
  866.         Inc(Left, W + GetMarginOffset);
  867.       end;
  868.     end
  869.     else if (MinOffset > 0) then begin
  870.       BtnRect := Bounds(Rect.Left + Left - 1, Rect.Top, MinOffset + 2,
  871.         Rect.Bottom - Rect.Top);
  872.       if DrawLowered then begin
  873.         DrawGlyphCheck(BtnRect);
  874.         CheckSize := GetMenuCheckMarkDimensions;
  875.         DrawCheckImage(BtnRect.Left + 2 + (MinOffset - LoWord(CheckSize)) div 2,
  876.           (Rect.Bottom + Rect.Top - HiWord(CheckSize)) div 2 + 1);
  877.       end
  878.       else if (mdSelected in State) and IsPopup and (Buttons = bsOffice) and
  879.         not ShowCheck then
  880.       begin
  881.         Frame3D(Canvas, BtnRect, clBtnHighlight, GrayColor, 1);
  882.       end;
  883.       Inc(Left, MinOffset + GetMarginOffset);
  884.     end;
  885.     if Item.Caption = Separator then begin
  886.       LineTop := (Rect.Top + Rect.Bottom) div 2 - 1;
  887.       if NewStyleControls then begin
  888.         Canvas.Pen.Width := 1;
  889.         MenuLine(Canvas, clBtnShadow, Rect.Left, LineTop, Rect.Right, LineTop);
  890.         MenuLine(Canvas, clBtnHighlight, Rect.Left, LineTop + 1, Rect.Right, LineTop + 1);
  891.       end
  892.       else begin
  893.         Canvas.Pen.Width := 2;
  894.         MenuLine(Canvas, clMenuText, Rect.Left, LineTop + 1, Rect.Right, LineTop + 1);
  895.       end;
  896.     end
  897.     else begin
  898.       MaxWidth := Canvas.TextWidth(DelChars(Item.Caption, '&') + Tab);
  899.       if (Item.Parent <> nil) and (Item.ShortCut <> scNone) then begin
  900.         for I := 0 to Item.Parent.Count - 1 do
  901.           MaxWidth := Max(Canvas.TextWidth(DelChars(Item.Parent.Items[I].Caption,
  902.             '&') + Tab), MaxWidth);
  903.       end;
  904.       Canvas.Brush.Style := bsClear;
  905.       LineTop := (Rect.Bottom + Rect.Top - Canvas.TextHeight('Ay')) div 2;
  906.       MenuTextOut(Rect.Left + Left, LineTop, Item.Caption, DT_EXPANDTABS or
  907.         DT_LEFT or DT_SINGLELINE);
  908.       if (Item.ShortCut <> scNone) and (Item.Count = 0) and IsPopup then begin
  909.         MenuTextOut(Rect.Left + Left + MaxWidth, LineTop,
  910.           ShortCutToText(Item.ShortCut), DT_EXPANDTABS or DT_LEFT or
  911.           DT_SINGLELINE);
  912.       end;
  913.     end;
  914.   end;
  915. end;
  916.  
  917. procedure MenuMeasureItem(AMenu: TMenu; Item: TMenuItem; Canvas: TCanvas;
  918.   ShowCheck: Boolean; Glyph: TGraphic; NumGlyphs: Integer; var ItemWidth,
  919.   ItemHeight: Integer; MinOffset: Cardinal {$IFDEF WIN32}; Images: TImageList;
  920.   ImageIndex: Integer {$ENDIF});
  921. var
  922.   IsPopup: Boolean;
  923.   W, H: Integer;
  924. {$IFDEF WIN32}
  925.   Ico: HIcon;
  926. {$ENDIF}
  927.  
  928.   function GetTextWidth(Item: TMenuItem): Integer;
  929.   var
  930.     I, MaxW: Integer;
  931.   begin
  932.     if IsPopup then begin
  933.       Result := Canvas.TextWidth(DelChars(Item.Caption, '&') + Tab);
  934.       MaxW := Canvas.TextWidth(ShortCutToText(Item.ShortCut) + ' ');
  935.       if (Item.Parent <> nil) and (Item.ShortCut <> scNone) then begin
  936.         for I := 0 to Item.Parent.Count - 1 do
  937.           with Item.Parent.Items[I] do begin
  938.             Result := Max(Result, Canvas.TextWidth(DelChars(Caption, '&') + Tab));
  939.             MaxW := Max(MaxW, Canvas.TextWidth(ShortCutToText(ShortCut) + ' '));
  940.           end;
  941.       end;
  942.       Result := Result + MaxW;
  943.       if Item.Count > 0 then Inc(Result, Canvas.TextWidth(Tab));
  944.     end
  945.     else Result := Canvas.TextWidth(DelChars(Item.Caption, '&'));
  946.   end;
  947.  
  948. begin
  949.   IsPopup := IsItemPopup(Item);
  950.   ItemHeight := GetDefItemHeight;
  951.   if IsPopup then begin
  952.     ItemWidth := GetMarginOffset * 2;
  953. {$IFDEF WIN32}
  954.     if Assigned(Images) then
  955.       MinOffset := Max(MinOffset, Images.Width + AddWidth);
  956. {$ENDIF}
  957.   end
  958.   else begin
  959.     ItemWidth := 0;
  960.     MinOffset := 0;
  961.   end;
  962.   Inc(ItemWidth, GetTextWidth(Item));
  963.   if IsPopup and ShowCheck then
  964.     Inc(ItemWidth, LoWord(GetMenuCheckMarkDimensions));
  965.   if Item.Caption = Separator then begin
  966.     ItemHeight := Max(Canvas.TextHeight(Separator) div 2, 9);
  967.   end
  968.   else begin
  969.     ItemHeight := Max(ItemHeight, Canvas.TextHeight(Item.Caption));
  970. {$IFDEF WIN32}
  971.     if Assigned(Images) and (IsPopup or ((ImageIndex >= 0) and
  972.       (ImageIndex < Images.Count))) then
  973.     begin
  974.       Inc(ItemWidth, Max(Images.Width + AddWidth, MinOffset));
  975.       if not IsPopup then Inc(ItemWidth, GetMarginOffset);
  976.       if (ImageIndex >= 0) and (ImageIndex < Images.Count) then
  977.         ItemHeight := Max(ItemHeight, Images.Height + AddHeight);
  978.     end else
  979. {$ENDIF}
  980.     if Assigned(Glyph) and not Glyph.Empty then begin
  981.       W := Glyph.Width;
  982.       if (Glyph is TBitmap) and (NumGlyphs in [2..5]) then
  983.         W := W div NumGlyphs;
  984.       H := Glyph.Height;
  985. {$IFDEF WIN32}
  986.       if Glyph is TIcon then begin
  987.         Ico := CreateRealSizeIcon(TIcon(Glyph));
  988.         try
  989.           GetIconSize(Ico, W, H);
  990.         finally
  991.           DestroyIcon(Ico);
  992.         end;
  993.       end;
  994. {$ENDIF}
  995.       W := Max(W + AddWidth, MinOffset);
  996.       Inc(ItemWidth, W);
  997.       if not IsPopup then Inc(ItemWidth, GetMarginOffset);
  998.       ItemHeight := Max(ItemHeight, H + AddHeight);
  999.     end
  1000.     else if MinOffset > 0 then begin
  1001.       Inc(ItemWidth, MinOffset);
  1002.       if not IsPopup then Inc(ItemWidth, GetMarginOffset);
  1003.     end;
  1004.   end;
  1005. end;
  1006.  
  1007. { TRxMainMenu }
  1008.  
  1009. constructor TRxMainMenu.Create(AOwner: TComponent);
  1010. begin
  1011.   inherited Create(AOwner);
  1012.   FCanvas := TControlCanvas.Create;
  1013.   FShowCheckMarks := True;
  1014.   FHook := TRxWindowHook.Create(Self);
  1015.   FHook.AfterMessage := WndMessage;
  1016. {$IFDEF WIN32}
  1017.   FImageChangeLink := TChangeLink.Create;
  1018.   FImageChangeLink.OnChange := ImageListChange;
  1019. {$ENDIF}
  1020. end;
  1021.  
  1022. destructor TRxMainMenu.Destroy;
  1023. begin
  1024. {$IFDEF WIN32}
  1025.   FImageChangeLink.Free;
  1026. {$ENDIF}
  1027.   SetStyle(msStandard);
  1028.   FHook.Free;
  1029.   FCanvas.Free;
  1030.   inherited Destroy;
  1031. end;
  1032.  
  1033. procedure TRxMainMenu.Loaded;
  1034. begin
  1035.   inherited Loaded;
  1036.   if IsOwnerDrawMenu then RefreshMenu(True);
  1037. end;
  1038.  
  1039. function TRxMainMenu.IsOwnerDrawMenu: Boolean;
  1040. begin
  1041.   Result := (FStyle <> msStandard)
  1042.     {$IFDEF WIN32} or (Assigned(FImages) and (FImages.Count > 0)) {$ENDIF};
  1043. end;
  1044.  
  1045. {$IFDEF WIN32}
  1046. procedure TRxMainMenu.Notification(AComponent: TComponent; Operation: TOperation);
  1047. begin
  1048.   inherited Notification(AComponent, Operation);
  1049.   if Operation = opRemove then begin
  1050.     if AComponent = FImages then SetImages(nil);
  1051.   end;
  1052. end;
  1053.  
  1054. procedure TRxMainMenu.ImageListChange(Sender: TObject);
  1055. begin
  1056.   if Sender = FImages then RefreshMenu(IsOwnerDrawMenu);
  1057. end;
  1058.  
  1059. procedure TRxMainMenu.SetImages(Value: TImageList);
  1060. var
  1061.   OldOwnerDraw: Boolean;
  1062. begin
  1063.   OldOwnerDraw := IsOwnerDrawMenu;
  1064.   if FImages <> nil then FImages.UnregisterChanges(FImageChangeLink);
  1065.   FImages := Value;
  1066.   if Value <> nil then begin
  1067.     FImages.RegisterChanges(FImageChangeLink);
  1068.     FImages.FreeNotification(Self);
  1069.   end;
  1070.   if IsOwnerDrawMenu then FHook.WinControl := FindForm
  1071.   else FHook.WinControl := nil;
  1072.   if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw);
  1073. end;
  1074. {$ENDIF}
  1075.  
  1076. procedure TRxMainMenu.SetStyle(Value: TRxMenuStyle);
  1077. begin
  1078.   if FStyle <> Value then begin
  1079.     FStyle := Value;
  1080.     if IsOwnerDrawMenu then FHook.WinControl := FindForm
  1081.     else FHook.WinControl := nil;
  1082.     RefreshMenu(IsOwnerDrawMenu);
  1083.   end;
  1084. end;
  1085.  
  1086. function TRxMainMenu.FindForm: TWinControl;
  1087. begin
  1088.   Result := FindControl(WindowHandle);
  1089.   if (Result = nil) and (Owner is TWinControl) then
  1090.     Result := TWinControl(Owner);
  1091. end;
  1092.  
  1093. procedure TRxMainMenu.Refresh;
  1094. begin
  1095.   RefreshMenu(IsOwnerDrawMenu);
  1096. end;
  1097.  
  1098. procedure TRxMainMenu.RefreshMenu(AOwnerDraw: Boolean);
  1099. {$IFDEF RX_D4}
  1100. begin
  1101.   Self.OwnerDraw := AOwnerDraw and (FHook.WinControl <> nil) and
  1102.     not (csDesigning in ComponentState);
  1103. {$ELSE}
  1104. var
  1105.   I: Integer;
  1106. begin
  1107.   if AOwnerDraw and (FHook.WinControl = nil) then Exit;
  1108.   if not (csDesigning in ComponentState) then
  1109.     for I := 0 to Items.Count - 1 do
  1110.       RefreshMenuItem(Items[I], AOwnerDraw);
  1111. {$ENDIF}
  1112. end;
  1113.  
  1114. procedure TRxMainMenu.DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  1115.   State: TMenuOwnerDrawState);
  1116. var
  1117.   Graphic: TGraphic;
  1118.   BackColor: TColor;
  1119.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1120. begin
  1121.   if Canvas.Handle <> 0 then begin
  1122.     Graphic := nil;
  1123.     BackColor := Canvas.Brush.Color;
  1124.     NumGlyphs := 1;
  1125.     GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
  1126. {$IFDEF WIN32}
  1127. {$IFDEF RX_D4}
  1128.     ImageIndex := Item.ImageIndex;
  1129. {$ELSE}
  1130.     ImageIndex := -1;
  1131. {$ENDIF}
  1132.     GetImageIndex(Item, State, ImageIndex);
  1133. {$ENDIF}
  1134.     DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
  1135.       BtnStyle(Style), Rect, FMinTextOffset, State
  1136.       {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1137.   end;
  1138. end;
  1139.  
  1140. procedure TRxMainMenu.DrawItem(Item: TMenuItem; Rect: TRect;
  1141.   State: TMenuOwnerDrawState);
  1142. var
  1143.   Graphic: TGraphic;
  1144.   BackColor: TColor;
  1145.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1146. begin
  1147.   if Canvas.Handle <> 0 then begin
  1148.     Graphic := nil;
  1149.     BackColor := Canvas.Brush.Color;
  1150.     NumGlyphs := 1;
  1151.     GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
  1152.     if BackColor <> clNone then begin
  1153.       Canvas.Brush.Color := BackColor;
  1154.       Canvas.FillRect(Rect);
  1155.     end;
  1156.     if Assigned(FOnDrawItem) then FOnDrawItem(Self, Item, Rect, State)
  1157.     else begin
  1158. {$IFDEF WIN32}
  1159. {$IFDEF RX_D4}
  1160.       ImageIndex := Item.ImageIndex;
  1161. {$ELSE}
  1162.       ImageIndex := -1;
  1163. {$ENDIF}
  1164.       GetImageIndex(Item, State, ImageIndex);
  1165. {$ENDIF}
  1166.       DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
  1167.         BtnStyle(Style), Rect, FMinTextOffset, State
  1168.         {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1169.     end;
  1170.   end;
  1171. end;
  1172.  
  1173. procedure TRxMainMenu.MeasureItem(Item: TMenuItem; var Width, Height: Integer);
  1174. begin
  1175.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Item, Width, Height)
  1176. end;
  1177.  
  1178. procedure TRxMainMenu.WndMessage(Sender: TObject; var AMsg: TMessage;
  1179.   var Handled: Boolean);
  1180. begin
  1181.   if IsOwnerDrawMenu then MenuWndMessage(Self, AMsg, Handled);
  1182. end;
  1183.  
  1184. procedure TRxMainMenu.GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  1185.   AFont: TFont; var Color: TColor; var Graphic: TGraphic; var NumGlyphs: Integer);
  1186. begin
  1187.   if Assigned(FOnGetItemParams) then
  1188.     FOnGetItemParams(Self, Item, State, AFont, Color, Graphic, NumGlyphs);
  1189.   if (Item <> nil) and (Item.Caption = Separator) then Graphic := nil;
  1190. end;
  1191.  
  1192. {$IFDEF WIN32}
  1193. procedure TRxMainMenu.GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  1194.   var ImageIndex: Integer);
  1195. begin
  1196.   if Assigned(FImages) and (Item <> nil) and (Item.Caption <> Separator) and
  1197.     Assigned(FOnGetImageIndex) then
  1198.     FOnGetImageIndex(Self, Item, State, ImageIndex);
  1199. end;
  1200. {$ENDIF}
  1201.  
  1202. procedure TRxMainMenu.CMMenuChanged(var Message: TMessage);
  1203. begin
  1204. {$IFNDEF RX_D4}
  1205.   if IsOwnerDrawMenu then RefreshMenu(True);
  1206. {$ENDIF}
  1207. end;
  1208.  
  1209. procedure TRxMainMenu.WMDrawItem(var Message: TWMDrawItem);
  1210. var
  1211.   State: TMenuOwnerDrawState;
  1212.   SaveIndex: Integer;
  1213.   Item: TMenuItem;
  1214. begin
  1215.   with Message.DrawItemStruct^ do begin
  1216. {$IFDEF WIN32}
  1217.     State := TMenuOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  1218. {$ELSE}
  1219.     State := TMenuOwnerDrawState(WordRec(itemState).Lo);
  1220. {$ENDIF}
  1221.     {if (mdDisabled in State) then State := State - [mdSelected];}
  1222.     Item := TMenuItem(Pointer(itemData));
  1223.     if Assigned(Item) and
  1224.       (FindItem(Item.Command, fkCommand) = Item) then
  1225.     begin
  1226.       SaveIndex := SaveDC(hDC);
  1227.       try
  1228.         FCanvas.Handle := hDC;
  1229.         SetDefaultMenuFont(FCanvas.Font);
  1230.         FCanvas.Font.Color := clMenuText;
  1231.         FCanvas.Brush.Color := clMenu;
  1232. {$IFDEF WIN32}
  1233.         if mdDefault in State then
  1234.           FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
  1235. {$ENDIF}
  1236.         if (mdSelected in State) {$IFDEF WIN32} and not
  1237.           (Style in [msBtnLowered, msBtnRaised]) {$ENDIF} then
  1238.         begin
  1239.           FCanvas.Brush.Color := clHighlight;
  1240.           FCanvas.Font.Color := clHighlightText;
  1241.         end;
  1242.         with rcItem do
  1243.           IntersectClipRect(FCanvas.Handle, Left, Top, Right, Bottom);
  1244.         DrawItem(Item, rcItem, State);
  1245.         FCanvas.Handle := 0;
  1246.       finally
  1247.         RestoreDC(hDC, SaveIndex);
  1248.       end;
  1249.     end;
  1250.   end;
  1251. end;
  1252.  
  1253. procedure TRxMainMenu.WMMeasureItem(var Message: TWMMeasureItem);
  1254. var
  1255.   Item: TMenuItem;
  1256.   Graphic: TGraphic;
  1257.   BackColor: TColor;
  1258.   DC: HDC;
  1259.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1260. begin
  1261.   with Message.MeasureItemStruct^ do begin
  1262.     Item := TMenuItem(Pointer(itemData));
  1263.     if Assigned(Item) and (FindItem(Item.Command, fkCommand) = Item) then
  1264.     begin
  1265.       DC := GetDC(0);
  1266.       try
  1267.         FCanvas.Handle := DC;
  1268.         SetDefaultMenuFont(FCanvas.Font);
  1269. {$IFDEF WIN32}
  1270.         if Item.Default then
  1271.           FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
  1272. {$ENDIF}
  1273.         Graphic := nil;
  1274.         BackColor := FCanvas.Brush.Color;
  1275.         NumGlyphs := 1;
  1276.         GetItemParams(Item, [], FCanvas.Font, BackColor, Graphic, NumGlyphs);
  1277. {$IFDEF WIN32}
  1278. {$IFDEF RX_D4}
  1279.         ImageIndex := Item.ImageIndex;
  1280. {$ELSE}
  1281.         ImageIndex := -1;
  1282. {$ENDIF}
  1283.         GetImageIndex(Item, [], ImageIndex);
  1284. {$ENDIF}
  1285.         MenuMeasureItem(Self, Item, FCanvas, FShowCheckMarks, Graphic,
  1286.           NumGlyphs, Integer(itemWidth), Integer(itemHeight), FMinTextOffset
  1287.           {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1288.         MeasureItem(Item, Integer(itemWidth), Integer(itemHeight));
  1289.       finally
  1290.         FCanvas.Handle := 0;
  1291.         ReleaseDC(0, DC);
  1292.       end;
  1293.     end;
  1294.   end;
  1295. end;
  1296.  
  1297. procedure TRxMainMenu.WMMenuSelect(var Message: TWMMenuSelect);
  1298. var
  1299.   MenuItem: TMenuItem;
  1300.   FindKind: TFindItemKind;
  1301.   MenuID: Integer;
  1302. begin
  1303.   if FCursor <> crDefault then
  1304.     with Message do begin
  1305.       FindKind := fkCommand;
  1306.       if MenuFlag and MF_POPUP <> 0 then begin
  1307.         FindKind := fkHandle;
  1308.         MenuId := GetSubMenu(Menu, IDItem);
  1309.       end
  1310.       else MenuId := IDItem;
  1311.       MenuItem := FindItem(MenuId, FindKind);
  1312.       if (MenuItem <> nil) and (IsItemPopup(MenuItem) or (MenuItem.Count = 0))
  1313.         and (MenuFlag and MF_HILITE <> 0) then
  1314.         SetCursor(Screen.Cursors[FCursor])
  1315.       else SetCursor(Screen.Cursors[crDefault]);
  1316.     end;
  1317. end;
  1318.  
  1319. { TPopupList }
  1320.  
  1321. type
  1322.   TPopupList = class(TList)
  1323.   private
  1324. {$IFNDEF WIN32}
  1325.     FMenuHelp: THelpContext;
  1326. {$ENDIF}
  1327.     procedure WndProc(var Message: TMessage);
  1328.   public
  1329.     Window: HWND;
  1330.     procedure Add(Popup: TPopupMenu);
  1331.     procedure Remove(Popup: TPopupMenu);
  1332.   end;
  1333.  
  1334. const
  1335.   PopupList: TPopupList = nil;
  1336.  
  1337. procedure TPopupList.WndProc(var Message: TMessage);
  1338. var
  1339.   I: Integer;
  1340.   MenuItem: TMenuItem;
  1341.   FindKind: TFindItemKind;
  1342.   ContextID: Integer;
  1343.   Handled: Boolean;
  1344. begin
  1345.   try
  1346.     case Message.Msg of
  1347.       WM_MEASUREITEM, WM_DRAWITEM:
  1348.         for I := 0 to Count - 1 do begin
  1349.           Handled := False;
  1350.           TRxPopupMenu(Items[I]).WndMessage(nil, Message, Handled);
  1351.           if Handled then Exit;
  1352.         end;
  1353.       WM_COMMAND:
  1354.         for I := 0 to Count - 1 do
  1355.           if TRxPopupMenu(Items[I]).DispatchCommand(Message.wParam) then Exit;
  1356.       WM_INITMENUPOPUP:
  1357.         for I := 0 to Count - 1 do
  1358.           with TWMInitMenuPopup(Message) do
  1359.             if TRxPopupMenu(Items[I]).DispatchPopup(MenuPopup) then Exit;
  1360.       WM_MENUSELECT:
  1361.         with TWMMenuSelect(Message) do begin
  1362.           FindKind := fkCommand;
  1363.           if MenuFlag and MF_POPUP <> 0 then begin
  1364.             FindKind := fkHandle;
  1365.             ContextId := GetSubMenu(Menu, IDItem);
  1366.           end
  1367.           else ContextId := IDItem;
  1368.           for I := 0 to Count - 1 do begin
  1369.             MenuItem := TRxPopupMenu(Items[I]).FindItem(ContextId, FindKind);
  1370.             if MenuItem <> nil then begin
  1371. {$IFNDEF WIN32}
  1372.               FMenuHelp := MenuItem.HelpContext;
  1373. {$ENDIF}
  1374.               Application.Hint := MenuItem.Hint;
  1375.               with TRxPopupMenu(Items[I]) do
  1376.                 if FCursor <> crDefault then begin
  1377.                   if (MenuFlag and MF_HILITE <> 0) then
  1378.                     SetCursor(Screen.Cursors[FCursor])
  1379.                   else SetCursor(Screen.Cursors[crDefault]);
  1380.                 end;
  1381.               Exit;
  1382.             end;
  1383.           end;
  1384. {$IFNDEF WIN32}
  1385.           FMenuHelp := 0;
  1386. {$ENDIF}
  1387.           Application.Hint := '';
  1388.         end;
  1389.       WM_MENUCHAR:
  1390.         for I := 0 to Count - 1 do
  1391.           with TRxPopupMenu(Items[I]) do
  1392.             if (Handle = HMenu(Message.LParam)) or
  1393.               (FindItem(Message.LParam, fkHandle) <> nil) then
  1394.             begin
  1395. {$IFDEF RX_D4}
  1396.               ProcessMenuChar(TWMMenuChar(Message));
  1397. {$ELSE}
  1398.               ProcessMenuChar(TRxPopupMenu(Items[I]), TWMMenuChar(Message));
  1399. {$ENDIF}
  1400.               Exit;
  1401.             end;
  1402. {$IFDEF WIN32}
  1403.       WM_HELP:
  1404.         with PHelpInfo(Message.LParam)^ do begin
  1405.           for I := 0 to Count - 1 do
  1406.             if TRxPopupMenu(Items[I]).Handle = hItemHandle then begin
  1407.               ContextID := TMenu(Items[I]).GetHelpContext(iCtrlID, True);
  1408.               if ContextID = 0 then
  1409.                 ContextID := TMenu(Items[I]).GetHelpContext(hItemHandle, False);
  1410.               if Screen.ActiveForm = nil then Exit;
  1411.               if (biHelp in Screen.ActiveForm.BorderIcons) then
  1412.                 Application.HelpCommand(HELP_CONTEXTPOPUP, ContextID)
  1413.               else
  1414.                 Application.HelpContext(ContextID);
  1415.               Exit;
  1416.             end;
  1417.         end;
  1418. {$ELSE}
  1419.       WM_ENTERIDLE:
  1420.         if (TWMEnterIdle(Message).Source = MSGF_MENU) and
  1421.           (GetKeyState(VK_F1) < 0) and (FMenuHelp <> 0) then
  1422.         begin
  1423.           Application.HelpContext(FMenuHelp);
  1424.           FMenuHelp := 0;
  1425.           Exit;
  1426.         end;
  1427. {$ENDIF WIN32}
  1428.     end;
  1429.     with Message do Result := DefWindowProc(Window, Msg, wParam, lParam);
  1430.   except
  1431.     Application.HandleException(Self);
  1432.   end;
  1433. end;
  1434.  
  1435. procedure TPopupList.Add(Popup: TPopupMenu);
  1436. begin
  1437.   if Count = 0 then Window := Classes.AllocateHWnd(WndProc);
  1438.   inherited Add(Popup);
  1439. end;
  1440.  
  1441. procedure TPopupList.Remove(Popup: TPopupMenu);
  1442. begin
  1443.   inherited Remove(Popup);
  1444.   if Count = 0 then Classes.DeallocateHWnd(Window);
  1445. end;
  1446.  
  1447. { TRxPopupMenu }
  1448.  
  1449. constructor TRxPopupMenu.Create(AOwner: TComponent);
  1450. begin
  1451.   inherited Create(AOwner);
  1452.   if PopupList = nil then
  1453.     PopupList := TPopupList.Create;
  1454.   FShowCheckMarks := True;
  1455.   FCanvas := TControlCanvas.Create;
  1456.   FCursor := crDefault;
  1457.   PopupList.Add(Self);
  1458. {$IFDEF WIN32}
  1459.   FImageChangeLink := TChangeLink.Create;
  1460.   FImageChangeLink.OnChange := ImageListChange;
  1461. {$ENDIF}
  1462. {$IFDEF RX_D4}
  1463.   FPopupPoint := Point(-1, -1);
  1464. {$ENDIF}
  1465. end;
  1466.  
  1467. destructor TRxPopupMenu.Destroy;
  1468. begin
  1469. {$IFDEF WIN32}
  1470.   FImageChangeLink.Free;
  1471. {$ENDIF}
  1472.   SetStyle(msStandard);
  1473.   PopupList.Remove(Self);
  1474.   FCanvas.Free;
  1475.   inherited Destroy;
  1476. end;
  1477.  
  1478. procedure TRxPopupMenu.Loaded;
  1479. begin
  1480.   inherited Loaded;
  1481.   if IsOwnerDrawMenu then RefreshMenu(True);
  1482. end;
  1483.  
  1484. {$IFDEF WIN32}
  1485. procedure TRxPopupMenu.Notification(AComponent: TComponent; Operation: TOperation);
  1486. begin
  1487.   inherited Notification(AComponent, Operation);
  1488.   if Operation = opRemove then begin
  1489.     if AComponent = FImages then SetImages(nil);
  1490.   end;
  1491. end;
  1492.  
  1493. procedure TRxPopupMenu.ImageListChange(Sender: TObject);
  1494. begin
  1495.   if Sender = FImages then RefreshMenu(IsOwnerDrawMenu);
  1496. end;
  1497.  
  1498. procedure TRxPopupMenu.SetImages(Value: TImageList);
  1499. var
  1500.   OldOwnerDraw: Boolean;
  1501. begin
  1502.   OldOwnerDraw := IsOwnerDrawMenu;
  1503.   if FImages <> nil then FImages.UnregisterChanges(FImageChangeLink);
  1504.   FImages := Value;
  1505.   if Value <> nil then begin
  1506.     FImages.RegisterChanges(FImageChangeLink);
  1507.     FImages.FreeNotification(Self);
  1508.   end;
  1509.   if IsOwnerDrawMenu <> OldOwnerDraw then RefreshMenu(not OldOwnerDraw);
  1510. end;
  1511. {$ENDIF}
  1512.  
  1513. {$IFDEF RX_D4}
  1514. function FindPopupControl(const Pos: TPoint): TControl;
  1515. var
  1516.   Window: TWinControl;
  1517. begin
  1518.   Result := nil;
  1519.   Window := FindVCLWindow(Pos);
  1520.   if Window <> nil then begin
  1521.     Result := Window.ControlAtPos(Pos, False);
  1522.     if Result = nil then Result := Window;
  1523.   end;
  1524. end;
  1525.  
  1526. procedure TRxPopupMenu.SetBiDiModeFromPopupControl;
  1527. var
  1528.   AControl: TControl;
  1529. begin
  1530.   if not SysLocale.MiddleEast then Exit;
  1531.   if FParentBiDiMode then begin
  1532.     AControl := FindPopupControl(FPopupPoint);
  1533.     if AControl <> nil then
  1534.       BiDiMode := AControl.BiDiMode
  1535.     else
  1536.       BiDiMode := Application.BiDiMode;
  1537.   end;
  1538. end;
  1539.  
  1540. function TRxPopupMenu.UseRightToLeftAlignment: Boolean;
  1541. var
  1542.   AControl: TControl;
  1543. begin
  1544.   Result := False;
  1545.   if not SysLocale.MiddleEast then Exit;
  1546.   if FParentBiDiMode then begin
  1547.     AControl := FindPopupControl(FPopupPoint);
  1548.     if AControl <> nil then
  1549.       Result := AControl.UseRightToLeftAlignment
  1550.     else
  1551.       Result := Application.UseRightToLeftAlignment;
  1552.   end
  1553.   else Result := (BiDiMode = bdRightToLeft);
  1554. end;
  1555. {$ENDIF RX_D4}
  1556.  
  1557. procedure TRxPopupMenu.Popup(X, Y: Integer);
  1558. const
  1559. {$IFDEF RX_D4}
  1560.   Flags: array[Boolean, TPopupAlignment] of Word =
  1561.     ((TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN),
  1562.      (TPM_RIGHTALIGN, TPM_LEFTALIGN, TPM_CENTERALIGN));
  1563.   Buttons: array[TTrackButton] of Word = (TPM_RIGHTBUTTON, TPM_LEFTBUTTON);
  1564. {$ELSE}
  1565.   Flags: array[TPopupAlignment] of Word = (TPM_LEFTALIGN, TPM_RIGHTALIGN,
  1566.     TPM_CENTERALIGN);
  1567. {$ENDIF}
  1568. var
  1569.   FOnPopup: TNotifyEvent;
  1570. begin
  1571. {$IFDEF RX_D4}
  1572.   FPopupPoint := Point(X, Y);
  1573.   FParentBiDiMode := ParentBiDiMode;
  1574.   try
  1575.     SetBiDiModeFromPopupControl;
  1576. {$ENDIF}
  1577.     FOnPopup := OnPopup;
  1578.     if Assigned(FOnPopup) then FOnPopup(Self);
  1579.     if IsOwnerDrawMenu then RefreshMenu(True);
  1580. {$IFNDEF WIN32}
  1581.     PopupList.FMenuHelp := HelpContext;
  1582. {$ENDIF}
  1583. {$IFDEF RX_D4}
  1584.     AdjustBiDiBehavior;
  1585.     TrackPopupMenu(Items.Handle,
  1586.       Flags[UseRightToLeftAlignment, Alignment] or Buttons[TrackButton], X, Y,
  1587.       0 { reserved }, PopupList.Window, nil);
  1588.   finally
  1589.     ParentBiDiMode := FParentBiDiMode;
  1590.   end;
  1591. {$ELSE}
  1592.   TrackPopupMenu(Items.Handle, Flags[Alignment] or TPM_RIGHTBUTTON, X, Y,
  1593.     0 { reserved }, PopupList.Window, nil);
  1594. {$ENDIF}
  1595. end;
  1596.  
  1597. procedure TRxPopupMenu.Refresh;
  1598. begin
  1599.   RefreshMenu(IsOwnerDrawMenu);
  1600. end;
  1601.  
  1602. function TRxPopupMenu.IsOwnerDrawMenu: Boolean;
  1603. begin
  1604.   Result := (FStyle <> msStandard)
  1605.     {$IFDEF WIN32} or (Assigned(FImages) and (FImages.Count > 0)) {$ENDIF};
  1606. end;
  1607.  
  1608. procedure TRxPopupMenu.RefreshMenu(AOwnerDraw: Boolean);
  1609. {$IFDEF RX_D4}
  1610. begin
  1611.   Self.OwnerDraw := AOwnerDraw and not (csDesigning in ComponentState);
  1612. {$ELSE}
  1613. var
  1614.   I: Integer;
  1615. begin
  1616.   if not (csDesigning in ComponentState) then
  1617.     for I := 0 to Items.Count - 1 do
  1618.       RefreshMenuItem(Items[I], AOwnerDraw);
  1619. {$ENDIF}
  1620. end;
  1621.  
  1622. procedure TRxPopupMenu.SetStyle(Value: TRxMenuStyle);
  1623. begin
  1624.   if FStyle <> Value then begin
  1625.     FStyle := Value;
  1626.     RefreshMenu(IsOwnerDrawMenu);
  1627.   end;
  1628. end;
  1629.  
  1630. procedure TRxPopupMenu.DefaultDrawItem(Item: TMenuItem; Rect: TRect;
  1631.   State: TMenuOwnerDrawState);
  1632. var
  1633.   Graphic: TGraphic;
  1634.   BackColor: TColor;
  1635.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1636. begin
  1637.   if Canvas.Handle <> 0 then begin
  1638.     Graphic := nil;
  1639.     BackColor := Canvas.Brush.Color;
  1640.     NumGlyphs := 1;
  1641.     GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
  1642. {$IFDEF WIN32}
  1643. {$IFDEF RX_D4}
  1644.     ImageIndex := Item.ImageIndex;
  1645. {$ELSE}
  1646.     ImageIndex := -1;
  1647. {$ENDIF}
  1648.     GetImageIndex(Item, State, ImageIndex);
  1649. {$ENDIF}
  1650.     DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
  1651.       BtnStyle(Style), Rect, FMinTextOffset, State
  1652.       {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1653.   end;
  1654. end;
  1655.  
  1656. procedure TRxPopupMenu.DrawItem(Item: TMenuItem; Rect: TRect;
  1657.   State: TMenuOwnerDrawState);
  1658. var
  1659.   Graphic: TGraphic;
  1660.   BackColor: TColor;
  1661.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1662. begin
  1663.   if Canvas.Handle <> 0 then begin
  1664.     Graphic := nil;
  1665.     BackColor := Canvas.Brush.Color;
  1666.     NumGlyphs := 1;
  1667.     GetItemParams(Item, State, Canvas.Font, BackColor, Graphic, NumGlyphs);
  1668.     if BackColor <> clNone then begin
  1669.       Canvas.Brush.Color := BackColor;
  1670.       Canvas.FillRect(Rect);
  1671.     end;
  1672.     if Assigned(FOnDrawItem) then FOnDrawItem(Self, Item, Rect, State)
  1673.     else begin
  1674. {$IFDEF WIN32}
  1675. {$IFDEF RX_D4}
  1676.       ImageIndex := Item.ImageIndex;
  1677. {$ELSE}
  1678.       ImageIndex := -1;
  1679. {$ENDIF}
  1680.       GetImageIndex(Item, State, ImageIndex);
  1681. {$ENDIF}
  1682.       DrawMenuItem(Self, Item, Graphic, NumGlyphs, Canvas, FShowCheckMarks,
  1683.         BtnStyle(Style), Rect, FMinTextOffset, State
  1684.         {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1685.     end;
  1686.   end;
  1687. end;
  1688.  
  1689. procedure TRxPopupMenu.MeasureItem(Item: TMenuItem; var Width, Height: Integer);
  1690. begin
  1691.   if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Item, Width, Height)
  1692. end;
  1693.  
  1694. procedure TRxPopupMenu.WndMessage(Sender: TObject; var AMsg: TMessage;
  1695.   var Handled: Boolean);
  1696. begin
  1697.   if IsOwnerDrawMenu then MenuWndMessage(Self, AMsg, Handled);
  1698. end;
  1699.  
  1700. procedure TRxPopupMenu.GetItemParams(Item: TMenuItem; State: TMenuOwnerDrawState;
  1701.   AFont: TFont; var Color: TColor; var Graphic: TGraphic; var NumGlyphs: Integer);
  1702. begin
  1703.   if Assigned(FOnGetItemParams) then
  1704.     FOnGetItemParams(Self, Item, State, AFont, Color, Graphic, NumGlyphs);
  1705.   if (Item <> nil) and (Item.Caption = Separator) then Graphic := nil;
  1706. end;
  1707.  
  1708. {$IFDEF WIN32}
  1709. procedure TRxPopupMenu.GetImageIndex(Item: TMenuItem; State: TMenuOwnerDrawState;
  1710.   var ImageIndex: Integer);
  1711. begin
  1712.   if Assigned(FImages) and (Item <> nil) and (Item.Caption <> Separator) and
  1713.     Assigned(FOnGetImageIndex) then
  1714.     FOnGetImageIndex(Self, Item, State, ImageIndex);
  1715. end;
  1716. {$ENDIF}
  1717.  
  1718. procedure TRxPopupMenu.DefaultDrawMargin(ARect: TRect; StartColor,
  1719.   EndColor: TColor);
  1720. var
  1721.   R: Integer;
  1722. begin
  1723.   with ARect do begin
  1724.     if NewStyleControls then R := Right - 3
  1725.     else R := Right;
  1726.     GradientFillRect(Canvas, Rect(Left, Top, R, Bottom), StartColor,
  1727.       EndColor, fdTopToBottom, 32);
  1728.     if NewStyleControls then begin
  1729.       MenuLine(Canvas, clBtnShadow, Right - 2, Top, Right - 2, Bottom);
  1730.       MenuLine(Canvas, clBtnHighlight, Right - 1, Top, Right - 1, Bottom);
  1731.     end;
  1732.   end;
  1733. end;
  1734.  
  1735. procedure TRxPopupMenu.DrawMargin(ARect: TRect);
  1736. begin
  1737.   if Assigned(FOnDrawMargin) then FOnDrawMargin(Self, ARect)
  1738.   else begin
  1739.     DefaultDrawMargin(ARect, DefMarginColor, RGB(
  1740.       GetRValue(DefMarginColor) div 4,
  1741.       GetGValue(DefMarginColor) div 4,
  1742.       GetBValue(DefMarginColor) div 4));
  1743.   end;
  1744. end;
  1745.  
  1746. procedure TRxPopupMenu.WMDrawItem(var Message: TWMDrawItem);
  1747. var
  1748.   State: TMenuOwnerDrawState;
  1749.   SaveIndex: Integer;
  1750.   Item: TMenuItem;
  1751.   MarginRect: TRect;
  1752. begin
  1753.   with Message.DrawItemStruct^ do begin
  1754. {$IFDEF WIN32}
  1755.     State := TMenuOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
  1756. {$ELSE}
  1757.     State := TMenuOwnerDrawState(WordRec(itemState).Lo);
  1758. {$ENDIF}
  1759.     Item := TMenuItem(Pointer(itemData));
  1760.     if Assigned(Item) and
  1761.       (FindItem(Item.Command, fkCommand) = Item) then
  1762.     begin
  1763.       SaveIndex := SaveDC(hDC);
  1764.       try
  1765.         FCanvas.Handle := hDC;
  1766.         if (Item.Parent = Self.Items) and (FLeftMargin > 0) then
  1767.           if (itemAction = ODA_DRAWENTIRE) then begin
  1768.             MarginRect := FCanvas.ClipRect;
  1769.             MarginRect.Left := 0;
  1770.             MarginRect.Right := FLeftMargin;
  1771.             DrawMargin(MarginRect);
  1772.           end;
  1773.         SetDefaultMenuFont(FCanvas.Font);
  1774.         FCanvas.Font.Color := clMenuText;
  1775.         FCanvas.Brush.Color := clMenu;
  1776. {$IFDEF WIN32}
  1777.         if mdDefault in State then
  1778.           FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
  1779. {$ENDIF}
  1780.         if (mdSelected in State) {$IFDEF WIN32} and
  1781.           not (Style in [msBtnLowered, msBtnRaised]) {$ENDIF} then
  1782.         begin
  1783.           FCanvas.Brush.Color := clHighlight;
  1784.           FCanvas.Font.Color := clHighlightText;
  1785.         end;
  1786.         if (Item.Parent = Self.Items) then
  1787.           Inc(rcItem.Left, LeftMargin + 1);
  1788.         with rcItem do
  1789.           IntersectClipRect(FCanvas.Handle, Left, Top, Right, Bottom);
  1790.         DrawItem(Item, rcItem, State);
  1791.         FCanvas.Handle := 0;
  1792.       finally
  1793.         RestoreDC(hDC, SaveIndex);
  1794.       end;
  1795.     end;
  1796.   end;
  1797. end;
  1798.  
  1799. procedure TRxPopupMenu.WMMeasureItem(var Message: TWMMeasureItem);
  1800. var
  1801.   Item: TMenuItem;
  1802.   Graphic: TGraphic;
  1803.   BackColor: TColor;
  1804.   NumGlyphs {$IFDEF WIN32}, ImageIndex {$ENDIF}: Integer;
  1805. begin
  1806.   with Message.MeasureItemStruct^ do begin
  1807.     Item := TMenuItem(Pointer(itemData));
  1808.     if Assigned(Item) and (FindItem(Item.Command, fkCommand) = Item) then
  1809.     begin
  1810.       FCanvas.Handle := GetDC(0);
  1811.       try
  1812.         SetDefaultMenuFont(FCanvas.Font);
  1813. {$IFDEF WIN32}
  1814.         if Item.Default then
  1815.           FCanvas.Font.Style := FCanvas.Font.Style + [fsBold];
  1816. {$ENDIF}
  1817.         Graphic := nil;
  1818.         BackColor := Canvas.Brush.Color;
  1819.         NumGlyphs := 1;
  1820.         GetItemParams(Item, [], FCanvas.Font, BackColor, Graphic, NumGlyphs);
  1821. {$IFDEF WIN32}
  1822. {$IFDEF RX_D4}
  1823.         ImageIndex := Item.ImageIndex;
  1824. {$ELSE}
  1825.         ImageIndex := -1;
  1826. {$ENDIF}
  1827.         GetImageIndex(Item, [], ImageIndex);
  1828. {$ENDIF}
  1829.         MenuMeasureItem(Self, Item, FCanvas, FShowCheckMarks, Graphic,
  1830.           NumGlyphs, Integer(itemWidth), Integer(itemHeight), FMinTextOffset
  1831.           {$IFDEF WIN32}, FImages, ImageIndex {$ENDIF});
  1832.         MeasureItem(Item, Integer(itemWidth), Integer(itemHeight));
  1833.         if (Item.Parent = Self.Items) then
  1834.           Inc(itemWidth, LeftMargin + 1);
  1835.       finally
  1836.         ReleaseDC(0, FCanvas.Handle);
  1837.         FCanvas.Handle := 0;
  1838.       end;
  1839.     end;
  1840.   end;
  1841. end;
  1842.  
  1843. {$IFNDEF WIN32}
  1844. procedure FreePopupList; far;
  1845. begin
  1846.   if PopupList <> nil then begin
  1847.     PopupList.Free;
  1848.     PopupList := nil;
  1849.   end;
  1850. end;
  1851. {$ENDIF}
  1852.  
  1853. initialization
  1854.   PopupList := nil;
  1855. {$IFDEF WIN32}
  1856. finalization
  1857.   if PopupList <> nil then PopupList.Free;
  1858. {$ELSE}
  1859.   AddExitProc(FreePopupList);
  1860. {$ENDIF}
  1861. end.